home *** CD-ROM | disk | FTP | other *** search
/ United Public Domain Gold 2 / United Public Domain Gold 2.iso / utilities / pu453.dms / pu453.adf / extras / basic_sources / Hyper.bas < prev    next >
BASIC Source File  |  1992-11-08  |  3KB  |  111 lines
  1. SCREEN 1,640,256,3,2
  2. WINDOW 1,"",(0,1)-(631,242),0,1
  3. LIBRARY "graphics.library"
  4. GOSUB remwindow
  5. REM $option K200
  6. RANDOMIZE TIMER
  7. PALETTE 0,.5,.5,.5
  8. PALETTE 1,1,1,1
  9. PALETTE 2,.3,.3,.3
  10. PALETTE 3,.8,.7,.4
  11. PALETTE 4,.7,.7,.7
  12. FOR x = 5 TO 7
  13.     PALETTE x,RND,RND,RND
  14. NEXT x
  15.  
  16. bwt 0,0,20,10,"",0,0
  17. bwt 2,1,18,9,"",0,-1
  18. bwt 6,3,14,7,"",0,0
  19. bwt 100,10,530,40,  "DAC - HYPERSpace - v0.1",3,0
  20. bwt 100,50,530,70,  "Run Program",2,0
  21. bwt 100,74,530,94,  "Edit Graphic",4,0
  22. bwt 100,98,530,118, "Edit Textscreen",4,0
  23. bwt 100,122,530,142,"Edit Bitmap",4,0
  24. bwt 100,146,530,166,"Edit DOS Extension",4,0
  25. bwt 100,170,530,190,"Build Screen",4,0
  26. bwt 100,194,530,214,"Edit Program",4,0
  27. bwt 100,218,530,238,"Configure",4,0
  28.  
  29. retry:
  30. WHILE MOUSE(0) <> 0 : WEND
  31. WHILE MOUSE(0) = 0 : WEND
  32. WHILE MOUSE(0) <> 0 : WEND
  33. x = MOUSE(1) : y = MOUSE(2)
  34.  
  35. IF x < 20 AND y < 10 THEN SYSTEM
  36. IF x < 100 OR x > 530 THEN GOTO retry
  37. IF y > 50  AND y < 70  THEN sel = 1 : GOTO skip
  38. IF y > 74  AND y < 94  THEN sel = 2 : GOTO skip
  39. IF y > 98  AND y < 118 THEN sel = 3 : GOTO skip
  40. IF y > 122 AND y < 142 THEN sel = 4 : GOTO skip
  41. IF y > 146 AND y < 166 THEN sel = 5 : GOTO skip
  42. IF y > 170 AND y < 190 THEN sel = 6 : GOTO skip
  43. IF y > 194 AND y < 214 THEN sel = 7 : GOTO skip
  44. IF y > 218 AND y < 238 THEN sel = 8 : GOTO skip
  45. GOTO retry
  46. skip:
  47.  
  48. fadescreen
  49.  
  50. bwt 100,100,530,130,"You selected"+STR$(sel),3,-1
  51. WHILE MOUSE(0) <> 0 : WEND
  52. WHILE MOUSE(0) = 0 : WEND
  53. WHILE MOUSE(0) <> 0 : WEND
  54. SYSTEM
  55.  
  56.  
  57. SUB BWT(x1,y1,x2,y2,txt$,col,flags) STATIC
  58.     l = LEN(txt$)
  59.     l = l * 8
  60.     DIM buf%(10000)
  61.     DIM buf2%(10000)
  62.     LOCATE 1,1
  63.     GET (0,0)-(l,9),buf2%    
  64.     LINE (0,0)-(l,9),0,bf
  65.     COLOR col
  66.     PRINT txt$
  67.     GET (0,0)-(l,8),buf%    
  68.     PUT (0,0),buf2%,PSET
  69.     ERASE buf2%
  70.     
  71.     IF x1 > x2 THEN SWAP x1,x2
  72.     IF y1 > y2 THEN SWAP y1,y2    
  73.     
  74.     IF NOT(flags) THEN
  75.         LINE (x1,y1)-(x2,y1),4
  76.         LINE (x2,y1)-(x2,y2),4
  77.         LINE (x1,y1)-(x1,y2),2
  78.         LINE (x2-1,y1+1)-(x2-1,y2-1),4
  79.         LINE (x1+1,y1+1)-(x1+1,y2-1),2
  80.         LINE (x1,y2)-(x2,y2),2
  81.     ELSE    
  82.         LINE (x1,y1)-(x2,y1),2
  83.         LINE (x2,y1)-(x2,y2),2
  84.         LINE (x1,y1)-(x1,y2),4
  85.         LINE (x2-1,y1+1)-(x2-1,y2-1),2
  86.         LINE (x1+1,y1+1)-(x1+1,y2-1),4
  87.         LINE (x1,y2)-(x2,y2),4
  88.     END IF
  89.     
  90.     LINE (x1+1,y1+1)-(x2-1,y2-1),0,bf
  91.     rl = (x2-x1) - l
  92.     rl = rl/2
  93.     rp = x1 + rl
  94.     ry = (((y2-y1) - 8)/2)+y1
  95.     IF txt$ <> "" THEN PUT (rp,ry),buf%,PSET
  96.     ERASE buf%    
  97. END SUB
  98.  
  99. SUB fadescreen STATIC
  100.     FOR x = 0 TO 256 STEP 4
  101.         LINE (0,x)-(640,x),0
  102.         LINE (0,255-x)-(640,255-x),0
  103.     NEXT x
  104.     FOR x = 1 TO 256 STEP 4
  105.         LINE (0,x)-(640,x),0
  106.         LINE (0,255-x)-(640,255-x),0
  107.     NEXT x
  108. END SUB
  109.     
  110. REM $include dh1:hbasic/includes/misc.inc
  111.